PROGRAM FRANCOIS
USE polymorphic_complextaylor
IMPLICIT NONE
REAL(DP) K1,X(2),L1,K2,L2,tune
INTEGER N,NO,method
TYPE(REAL_8) Y(2),K1P,L1P,K2P,L2P
TYPE(DAMAP) ID
TYPE(NORMALFORM) NORM
TYPE(GMAP) G

N=10


L1=0.2D0
K1=50.0D0
L2=0.2D0
K2=-k1

X=0.d0

WRITE(6,*) X

CALL QUAD(X,L1,K1,N)
CALL QUAD(X,L2,K2,N)

WRITE(6,*) X

no=2
WRITE(6,*) " no "
!READ(5,*) NO


100 CONTINUE
CALL INIT(NO,1,4,0,.TRUE.)
CALL ALLOC(ID);CALL ALLOC(NORM);
CALL ALLOC(G,6)
CALL ALLOC(Y);CALL ALLOC(K1P,L1P,K2P,L2P);


X=0.d0

K1P=K1+(1.D0.MONO.'001') 
L1P=L1+(1.D0.MONO.'00001');
K2P=K2+(1.D0.MONO.'0001') 
L2P=L2+(1.D0.MONO.'000001');

ID=1
!x(1)=.02d0
!x(2)=.03d0

Y(1)=X(1)+ID%V(1)
Y(2)=X(2)+ID%V(2)

CALL QUADP(Y,L1P,K1P,N)
CALL QUADP(Y,L2P,K2P,N)
!CALL PRINT(Y(1),6)
!CALL PRINT(Y(2),6)

write(6,*) " Do you want to fit the tune by simple acos(1/2 Trace) formula ? "
write(6,*) " or by Normal Form  "
write(6,*) " simple Trace type 1      Normal Form type 2     Stop iteration 0"
read(5,*) method 

if(method==0) goto 101

if(method == 2) then
   ID%V(1)=Y(1)%T
   ID%V(2)=Y(2)%T
   NORM=ID


   WRITE(6,*) "Present Tune = ",NORM%TUNE(1)
   g%v(5)=(NORM%DHDJ%V(1)<='00')-0.12d0
else

    g%v(5)=( (y(1)%t<='10')+ (y(2)%t<='01' ))/2.d0
    g%v(5)=acos(g%v(5))/2.d0/pi
    tune=g%v(5)
	WRITE(6,*) "Present Tune = ",tune
    g%v(5)=g%v(5)-0.12d0

endif
    
    tune=g%v(5)
	WRITE(6,*) "Present distance from Target = ",tune


! SETTING UP GMAP CORRESPONDING TO A LAGRANGE MULTIPLIER INVERSION   
g%v(1)=(1.d0.mono.'1000')+(1.d0.mono.'00001')*(g%v(5).d.1)
g%v(2)=(1.d0.mono.'0100')+(1.d0.mono.'00001')*(g%v(5).d.2)
g%v(3)=(1.d0.mono.'0010')+(1.d0.mono.'00001')*(g%v(5).d.3)
g%v(4)=(1.d0.mono.'0001')+(1.d0.mono.'00001')*(g%v(5).d.4)
g%v(6)=(1.d0.mono.'000001')


g=g.oo.(-1)

K1=K1+(G%V(1).SUB.'0')
K2=K2+(G%V(2).SUB.'0')
L1=L1+(G%V(3).SUB.'0')
L2=L2+(G%V(4).SUB.'0')
WRITE(6,*) "K1 =", k1
WRITE(6,*) "K2 =", k2
WRITE(6,*) "L1 =", L1
WRITE(6,*) "L2 =", L2


CALL KILL(ID);CALL KILL(NORM);
CALL KILL(G)
CALL KILL(Y);CALL KILL(K1P,L1P,K2P,L2P);

GOTO 100

101 continue
CALL KILL(ID);CALL KILL(NORM);
CALL KILL(G)
CALL KILL(Y);CALL KILL(K1P,L1P,K2P,L2P);



END PROGRAM FRANCOIS

SUBROUTINE QUAD(X,L,K,N)
USE tree_element_MODULE
IMPLICIT NONE
INTEGER N,I
REAL(DP) K,L,X(2),DL

DL=L/N

DO I=1,N

X(1)=X(1)+DL*X(2)/SQRT(1.D0-X(2)**2)
X(2)=X(2)-DL*K*X(1)

ENDDO

END SUBROUTINE QUAD

SUBROUTINE QUADP(X,L,K,N)
USE tree_element_MODULE
IMPLICIT NONE
INTEGER N,I
TYPE(REAL_8) K,L,X(2),DL

CALL ALLOC(DL)

DL=L/N

DO I=1,N

X(1)=X(1)+DL*X(2)/SQRT(1.D0-X(2)**2)
X(2)=X(2)-DL*K*X(1)

ENDDO

CALL KILL(DL)

END SUBROUTINE QUADP